!
! Copyright (C) 1991-2004  ; All Rights Reserved ; Colorado State University
! Colorado State University Research Foundation ; ATMET, LLC
! 
! This file is free software; you can redistribute it and/or modify it under the
! terms of the GNU General Public License as published by the Free Software 
! Foundation; either version 2 of the License, or (at your option) any later version.
! 
! This software is distributed in the hope that it will be useful, but WITHOUT ANY 
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A 
! PARTICULAR PURPOSE.  See the GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License along with this 
! program; if not, write to the Free Software Foundation, Inc., 
! 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
!===============================================================================
!############################# Change Log ##################################
! 5.0.0
!
!###########################################################################

subroutine node_sendst(isflag)

  use mem_grid, only: &
       NGRID            ! INTENT(IN)
  use node_mod, only: &
       NMACHS,        & ! INTENT(IN)
       IGET_PATHS,    & ! INTENT(IN)
       NODE_BUFFS,    & ! INTENT(INOUT)
       F_NDMD_SIZE,   & ! INTENT(IN)
       MACHS,         & ! INTENT(IN)
       IRECV_REQ,     & ! INTENT(INOUT)
       IPATHS,        & ! INTENT(IN)
       MYNUM,         & ! INTENT(IN)
       MZP,           & ! INTENT(IN)
       MXP,           & ! INTENT(IN)
       MYP,           & ! INTENT(IN)
       I0,            & ! INTENT(IN)
       J0,            & ! INTENT(IN)
       ISEND_REQ        ! INTENT(INOUT)
  use mem_scratch, only: &
       SCRATCH          ! INTENT(OUT)
  use mem_basic, only: &
       BASIC_G          ! INTENT(IN)

  implicit none
  ! Arguments:
  integer, intent(in) :: isflag
  ! Local Variables:
  integer :: ipos
  integer :: itype, nm, i1, i2, j1, j2, mtp

  if (isflag >= 2 .and. isflag <= 4) itype=isflag
  if (isflag >= 5 .and. isflag <= 6) itype=1

  !---------------------------------------------------
  !
  !   First, before we send anything, let's post the receives


  do nm=1,nmachs
     if (iget_paths(itype,ngrid,nm).ne.0) then
        call parf_get_noblock(node_buffs(nm)%lbc_recv_buff(1),          &
             node_buffs(nm)%nrecv*f_ndmd_size, machs(nm), 10000+isflag, &
             irecv_req(nm))
     endif
  enddo

  !---------------------------------------------------
  !
  !   Now we can actually go on to sending the stuff

  do nm=1,nmachs

     if(ipaths(1,itype,ngrid,nm).ne.0) then

        i1=ipaths(1,itype,ngrid,nm)
        i2=ipaths(2,itype,ngrid,nm)
        j1=ipaths(3,itype,ngrid,nm)
        j2=ipaths(4,itype,ngrid,nm)

       ipos = 1
        call parf_pack_int(i1, 1, node_buffs(nm)%lbc_send_buff(1), &
             node_buffs(nm)%nsend*f_ndmd_size, ipos)
        call parf_pack_int(i2, 1, node_buffs(nm)%lbc_send_buff(1), &
             node_buffs(nm)%nsend*f_ndmd_size, ipos)
        call parf_pack_int(j1, 1, node_buffs(nm)%lbc_send_buff(1), &
             node_buffs(nm)%nsend*f_ndmd_size, ipos)
        call parf_pack_int(j2, 1, node_buffs(nm)%lbc_send_buff(1), &
             node_buffs(nm)%nsend*f_ndmd_size, ipos)
        call parf_pack_int(mynum, 1, node_buffs(nm)%lbc_send_buff(1), &
             node_buffs(nm)%nsend*f_ndmd_size, ipos)

        if(isflag == 2) then
           call mkstbuff(mzp,mxp,myp,basic_g(ngrid)%up(1,1,1)  &
                ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtp)
           call parf_pack_real(scratch%scr1(1), mtp, &
                node_buffs(nm)%lbc_send_buff(1), &
                node_buffs(nm)%nsend*f_ndmd_size, ipos)
        elseif (isflag == 3) then
           
           call mkstbuff(mzp,mxp,myp,basic_g(ngrid)%vp(1,1,1)  &
                ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtp)
           call parf_pack_real(scratch%scr1(1), mtp, &
                node_buffs(nm)%lbc_send_buff(1), &
                node_buffs(nm)%nsend*f_ndmd_size, ipos)
        elseif (isflag == 4) then
           call mkstbuff(mzp,mxp,myp,basic_g(ngrid)%pp(1,1,1)  &
                ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtp)
           call parf_pack_real(scratch%scr1(1), mtp, &
                node_buffs(nm)%lbc_send_buff(1), &
                node_buffs(nm)%nsend*f_ndmd_size, ipos)
        elseif(isflag == 5) then
           call mkstbuff(mzp,mxp,myp,basic_g(ngrid)%up(1,1,1)  &
                ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtp)
           call parf_pack_real(scratch%scr1(1), mtp, &
                node_buffs(nm)%lbc_send_buff(1), &
                node_buffs(nm)%nsend*f_ndmd_size, ipos)
           call mkstbuff(mzp,mxp,myp,basic_g(ngrid)%vp(1,1,1)  &
                ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtp)
           call parf_pack_real(scratch%scr1(1), mtp, &
                node_buffs(nm)%lbc_send_buff(1), &
                node_buffs(nm)%nsend*f_ndmd_size, ipos)
        elseif (isflag == 6) then
           call mkstbuff(mzp,mxp,myp,basic_g(ngrid)%wp(1,1,1)  &
                ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtp)
           call parf_pack_real(scratch%scr1(1), mtp, &
                node_buffs(nm)%lbc_send_buff(1), &
                node_buffs(nm)%nsend*f_ndmd_size, ipos)

           call mkstbuff(mzp,mxp,myp,basic_g(ngrid)%pp(1,1,1)  &
                ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtp)
           call parf_pack_real(scratch%scr1(1), mtp, &
                node_buffs(nm)%lbc_send_buff(1), &
                node_buffs(nm)%nsend*f_ndmd_size, ipos)

        endif

        call parf_send_noblock(node_buffs(nm)%lbc_send_buff(1),  &
             ipos-1, ipaths(5,itype,ngrid,nm), 10000+isflag, isend_req(nm))

     endif

  enddo


  return
end subroutine node_sendst
!
!     ****************************************************************
!
subroutine node_getst(isflag)

  use mem_grid, only: &
       NGRID,         & ! INTENT(IN)
       NZP              ! INTENT(IN)
  use node_mod, only: &
       NMACHS,        & ! INTENT(IN)
       IPATHS,        & ! INTENT(IN)
       ISEND_REQ,     & ! INTENT(INOUT)
       IGET_PATHS,    & ! INTENT(IN)
       IRECV_REQ,     & ! INTENT(INOUT)
       NODE_BUFFS,    & ! INTENT(INOUT)
       F_NDMD_SIZE,   & ! INTENT(IN)
       MZP,           & ! INTENT(IN)
       MXP,           & ! INTENT(IN)
       MYP,           & ! INTENT(IN)
       I0,            & ! INTENT(IN)
       J0               ! INTENT(IN)
  use mem_scratch, only: &
       SCRATCH          ! INTENT(OUT)
  use mem_basic, only: &
       BASIC_G          ! INTENT(IN)

  implicit none
  ! Arguments:
  integer, intent(in) :: isflag
  ! Local Variables:
  integer :: ipos
  integer :: itype, nm, i1, i2, j1, j2, mtp, mtc, node_src, nptsxy

  if (isflag.ge.2.and.isflag.le.4) itype=isflag
  if (isflag.ge.5.and.isflag.le.6) itype=1

  !_____________________________________________________________________
  !
  !  First, let's make sure our sends are all finished and de-allocated

  do nm=1,nmachs
     if(ipaths(1,itype,ngrid,nm).ne.0) then
        call parf_wait_nostatus(isend_req(nm))
     endif
  enddo
  !_____________________________________________________________________
  !
  !  Now, let's wait on our receives

  do nm=1,nmachs
     if (iget_paths(itype,ngrid,nm).ne.0) then
        call parf_wait_nostatus(irecv_req(nm))
     endif
  enddo
  !_____________________________________________________________________
  !
  !  We got all our stuff. Now unpack it into appropriate space.


  do nm=1,nmachs

     if (iget_paths(itype,ngrid,nm).ne.0) then
        ipos = 1
        call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, i1, 1)
        call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, i2, 1)
        call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, j1, 1)
        call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, j2, 1)
        call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, node_src, 1)

        nptsxy=(i2-i1+1)*(j2-j1+1)

        mtp=nzp * nptsxy

        if(isflag == 2) then
           call parf_unpack_real(node_buffs(nm)%lbc_recv_buff(1), &
                node_buffs(nm)%nrecv*f_ndmd_size, ipos, scratch%scr1(1), mtp)
           call exstbuff(mzp,mxp,myp,basic_g(ngrid)%up(1,1,1)  &
               ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtc)
        elseif(isflag == 3) then
           call parf_unpack_real(node_buffs(nm)%lbc_recv_buff(1), &
                node_buffs(nm)%nrecv*f_ndmd_size, ipos, scratch%scr1(1), mtp)
           call exstbuff(mzp,mxp,myp,basic_g(ngrid)%vp(1,1,1)  &
               ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtc)
        elseif(isflag == 4) then
           call parf_unpack_real(node_buffs(nm)%lbc_recv_buff(1), &
                node_buffs(nm)%nrecv*f_ndmd_size, ipos, scratch%scr1(1), mtp)

           call exstbuff(mzp,mxp,myp,basic_g(ngrid)%pp(1,1,1)  &
               ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtc)
        elseif(isflag == 5) then
           call parf_unpack_real(node_buffs(nm)%lbc_recv_buff(1), &
                node_buffs(nm)%nrecv*f_ndmd_size, ipos, scratch%scr1(1), mtp)
           call exstbuff(mzp,mxp,myp,basic_g(ngrid)%up(1,1,1)  &
               ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtc)
           call parf_unpack_real(node_buffs(nm)%lbc_recv_buff(1), &
                node_buffs(nm)%nrecv*f_ndmd_size, ipos, scratch%scr1(1), mtp)
           call exstbuff(mzp,mxp,myp,basic_g(ngrid)%vp(1,1,1)  &
               ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtc)
        elseif(isflag == 6) then
           call parf_unpack_real(node_buffs(nm)%lbc_recv_buff(1), &
                node_buffs(nm)%nrecv*f_ndmd_size, ipos, scratch%scr1(1), mtp)
           call exstbuff(mzp,mxp,myp,basic_g(ngrid)%wp(1,1,1)  &
               ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtc)
           call parf_unpack_real(node_buffs(nm)%lbc_recv_buff(1), &
                node_buffs(nm)%nrecv*f_ndmd_size, ipos, scratch%scr1(1), mtp)
           call exstbuff(mzp,mxp,myp,basic_g(ngrid)%pp(1,1,1)  &
               ,scratch%scr1(1),i1-i0,i2-i0,j1-j0,j2-j0,mtc)
        endif

     endif

  enddo

return
end subroutine node_getst

!*********************************************************************

subroutine mkstbuff(n1, n2, n3, a, b, il, ir, jb, jt, ind)
  implicit none
  ! Arguments:
  integer, intent(in)  :: n1, n2, n3, il, ir, jb, jt
  integer, intent(out) :: ind
  real, intent(in)     :: a(n1,n2,n3)
  real, intent(inout)  :: b(*)
  ! Local Variables:
  integer :: i, j, k

  ind=0
  do j=jb,jt
     do i=il,ir
        do k=1,n1
           ind=ind+1
           b(ind)=a(k,i,j)
        enddo
     enddo
  enddo

end subroutine mkstbuff

!*********************************************************************

subroutine mkstbuffs(n1, n2, n3, a, b, il, ir, jb, jt, ind)
  implicit none
  ! Arguments:
  integer, intent(in)  :: n1, n2, n3, il, ir, jb, jt
  integer, intent(out) :: ind
  real, intent(in)     :: a(n1,n2,n3)
  real, intent(inout)  :: b(*)
  ! Local Variables:
  integer :: i, j, k

  ind=0
  do j=jb,jt
     do i=il,ir
        do k=1,n3
           ind=ind+1
           b(ind)=a(i,j,k)
        enddo
     enddo
  enddo

end subroutine mkstbuffs

!*********************************************************************

subroutine exstbuff(n1, n2, n3, a, b, il, ir, jb, jt, ind)
  implicit none
  ! Arguments:
  integer, intent(in)  :: n1, n2, n3, il, ir, jb, jt
  integer, intent(out) :: ind
  real, intent(inout)  :: a(n1,n2,n3)
  real, intent(in)     :: b(*)
  ! Local Variables:
  integer :: i, j, k

  ind=0
  do j=jb,jt
     do i=il,ir
        do k=1,n1
           ind=ind+1
           a(k,i,j)=b(ind)
        enddo
     enddo
  enddo

end subroutine exstbuff

!*********************************************************************

subroutine exstbuffs(n1, n2, n3, a, b, il, ir, jb, jt, ind)
  implicit none
  ! Arguments:
  integer, intent(in)  :: n1, n2, n3, il, ir, jb, jt
  integer, intent(out) :: ind
  real, intent(inout)  :: a(n1,n2,n3)
  real, intent(in)     :: b(*)
  ! Local Variables:
  integer :: i, j, k

  ind=0
  do j=jb,jt
     do i=il,ir
        do k=1,n3
           ind=ind+1
           a(i,j,k)=b(ind)
        enddo
     enddo
  enddo

end subroutine exstbuffs


